home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / pointers.swg / 0020_Double Linked Lists.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  4.8 KB  |  192 lines
  1.  
  2. program Demo_Doubly_Linked_List_Sort;
  3.  
  4. const
  5.   co_MaxNode = 1000;
  6.  
  7. type
  8.   T_St15   = string[15];
  9.  
  10.   T_PoNode = ^T_Node;
  11.  
  12.   T_Node   = record
  13.                Data : T_St15;
  14.                Next,
  15.                Prev : T_PoNode
  16.              end;
  17.  
  18.   T_PoArNodes  = ^T_ArNodePtrs;
  19.   T_ArNodePtrs = array[1..succ(co_MaxNode)] of T_PoNode;
  20.  
  21.  
  22.   function RandomString : {output}
  23.                            T_St15;
  24.   var
  25.     by_Index : byte;
  26.     st_Temp  : T_St15;
  27.   begin
  28.     st_Temp[0] := chr(succ(random(15)));
  29.     for by_Index := 1 to length(st_Temp) do
  30.       st_Temp[by_Index] := chr(random(26) + 65);
  31.     RandomString := st_Temp
  32.   end;
  33.  
  34.   procedure AddNode({update}
  35.                      var
  36.                        po_Node : T_PoNode);
  37.   begin
  38.     if (maxavail > sizeof(T_Node)) then
  39.       begin
  40.         new(po_Node^.Next);
  41.         po_Node^.Next^.Next := nil;
  42.         po_Node^.Next^.Prev := po_Node;
  43.         po_Node^.Next^.Data := RandomString
  44.       end
  45.   end;
  46.  
  47.   procedure DisplayList({input}
  48.                          po_Node : T_PoNode);
  49.   var
  50.     po_Temp : T_PoNode;
  51.   begin
  52.     po_Temp := po_Node;
  53.     repeat
  54.       write(po_Temp^.Data:20);
  55.       po_Temp := po_Temp^.Next
  56.     until (po_Temp^.Next = nil);
  57.     write(po_Temp^.Data:20)
  58.   end;
  59.  
  60.   procedure ShellSortNodes ({update}
  61.                              var
  62.                                ar_Nodes   : T_ArNodePtrs;
  63.                             {input }
  64.                              wo_NodeTotal : word);
  65.   var
  66.     Temp   : T_PoNode;
  67.     Index1,
  68.     Index2,
  69.     Index3 : word;
  70.   begin
  71.     Index3 := 1;
  72.     repeat
  73.       Index3 := succ(3 * Index3)
  74.     until (Index3 > wo_NodeTotal);
  75.     repeat
  76.       Index3 := (Index3 div 3);
  77.       for Index1 := succ(Index3) to wo_NodeTotal do
  78.         begin
  79.           Temp := ar_Nodes[Index1];
  80.           Index2 := Index1;
  81.           while (ar_Nodes[(Index2 - Index3)]^.Data > Temp^.Data) do
  82.             begin
  83.               ar_Nodes[Index2] := ar_Nodes[(Index2 - Index3)];
  84.               Index2 := (Index2 - Index3);
  85.               if (Index2 <= Index3) then
  86.                 break
  87.             end;
  88.           ar_Nodes[Index2] := Temp
  89.         end
  90.     until (Index3 = 1)
  91.   end;        (* ShellSortNodes.                                      *)
  92.  
  93.   procedure RebuildList({input }
  94.                          var
  95.                            ar_Nodes : T_ArNodePtrs;
  96.                         {update}
  97.                          var
  98.                            po_Head  : T_PoNode);
  99.   var
  100.     wo_Index   : word;
  101.     po_Current : T_PoNode;
  102.   begin
  103.     wo_Index := 1;
  104.     po_Head := ar_Nodes[wo_Index];
  105.     po_Head^.Prev := nil;
  106.     po_Head^.Next := ar_Nodes[succ(wo_Index)];
  107.     po_Current := po_Head;
  108.     repeat
  109.       inc(wo_Index);
  110.       po_Current := po_Current^.Next;
  111.       po_Current^.Next := ar_Nodes[succ(wo_Index)];
  112.       po_Current^.Prev := ar_Nodes[pred(wo_Index)]
  113.     until (ar_Nodes[succ(wo_Index)] = nil)
  114.   end;
  115.  
  116. var
  117.   wo_Index    : word;
  118.  
  119.   po_Heap     : pointer;
  120.  
  121.   po_Head,
  122.   po_Current   : T_PoNode;
  123.  
  124.   po_NodeArray : T_PoArNodes;
  125.  
  126. BEGIN
  127.               (* Initialize pseudo-random number generator.           *)
  128.   randomize;
  129.  
  130.               (* Mark initial HEAP state.                             *)
  131.   mark(po_Heap);
  132.  
  133.               (* Initialize list head node.                           *)
  134.   new(po_Head);
  135.   with po_Head^ do
  136.     begin
  137.       Next := nil;
  138.       Prev := nil;
  139.       Data := RandomString
  140.     end;
  141.  
  142.               (* Create doubly linked list of random strings.         *)
  143.   po_Current := po_Head;
  144.   for wo_Index := 1 to co_MaxNode do
  145.     begin
  146.       AddNode(po_Current);
  147.       if (wo_Index < co_MaxNode) then
  148.         po_Current := po_Current^.Next
  149.     end;
  150.  
  151.   writeln('Total Nodes = ', wo_Index);
  152.   readln;
  153.  
  154.   DisplayList(po_Head);
  155.   writeln;
  156.   writeln;
  157.  
  158.               (* Allocate array of node pointers on the HEAP.         *)
  159.   if (maxavail > sizeof(T_ArNodePtrs)) then
  160.     new(po_NodeArray);
  161.  
  162.               (* Set them all to NIL.                                 *)
  163.   fillchar(po_NodeArray^, sizeof(po_NodeArray^), 0);
  164.  
  165.               (* Assign pointer in array to nodes.                    *)
  166.   wo_Index := 0;
  167.   po_Current := po_Head;
  168.   repeat
  169.     inc(wo_Index);
  170.     po_NodeArray^[wo_Index] := po_Current;
  171.     po_Current := po_Current^.Next
  172.   until (po_Current^.Next = nil);
  173.  
  174.               (* ShellSort the array of nodes.                        *)
  175.   ShellSortNodes(po_NodeArray^, wo_Index);
  176.  
  177.               (* Re-build the doubly linked-list from array of nodes. *)
  178.   RebuildList(po_NodeArray^, po_Head);
  179.  
  180.               (* Deallocate array of nodes.                           *)
  181.   dispose(po_NodeArray);
  182.  
  183.   writeln;
  184.   writeln;
  185.   DisplayList(po_Head);
  186.  
  187.               (* Release HEAP memory used.                            *)
  188.   release(po_Heap)
  189.  
  190. END.
  191.  
  192.